home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 21 / AACD 21.iso / AACD / Programming / Comal / CITDemos / TinyPaint < prev   
Encoding:
Text File  |  2001-04-12  |  6.9 KB  |  303 lines
  1. // Tiny paint with special 8 color screen
  2.  
  3. USE CITScreen
  4. USE CITWindow
  5. USE CITGadgets
  6. USE CITText
  7. USE CITRequesters
  8. USE CITWorkbench
  9. USE RastPort
  10. USE TempRas
  11. USE IntuitionWindow
  12. USE GraphicsLibrary
  13.  
  14. // Initialization variables
  15. DIM Error OF SHORT
  16. DIM GadTopEdge OF SHORT
  17. DIM GadHeight OF SHORT
  18.  
  19. // Working variables
  20. DIM RP OF POINTER TO RastPort
  21. DIM ButtonDown OF SHORT
  22. DIM CURVE OF SHORT
  23. DIM LINE OF SHORT
  24. DIM CIRCLE OF SHORT
  25. DIM FILL OF SHORT
  26. DIM MODE OF SHORT
  27. DIM MouseX OF SHORT
  28. DIM MouseY OF SHORT
  29. DIM DownX OF SHORT
  30. DIM DownY OF SHORT
  31.  
  32. CURVE:=0
  33. LINE:=1
  34. CIRCLE:=2
  35. FILL:=3
  36. XYratio:=1.9
  37.  
  38. DIM PaintScreen OF CITScreen
  39. PaintScreen.Label("New Paint Screen")
  40. PaintScreen.Depth(3)
  41. CITWorkbench.InsObject(PaintScreen,Error)
  42.  
  43. DIM PaintWd OF CITWindow
  44. PaintWd.Position(0,10)
  45. PaintWd.Size(640,256)     // Height will be maximal
  46. PaintWd.DragBar
  47. PaintWd.DepthGadget
  48. PaintWd.Activate
  49. PaintWd.SelectEventHandler(Button(,,))
  50. PaintWd.PointerEventHandler(MouseMove(,))
  51. PaintScreen.InsObject(PaintWd,Error)
  52. IF Error THEN
  53.   STOP "Could'nt open the window"
  54. ENDIF
  55. RP:=PaintWd.Window@.RPort
  56. IF NOT AllocTmpRas(RP@,640,256) THEN
  57.   STOP "No memory"
  58. ENDIF
  59.  
  60. SetAPen(RP,1)
  61.  
  62. GadHeight:=PaintWd.Window@.Height/13
  63.  
  64. DIM Requester OF CITRequester
  65. PaintWd.InsObject(Requester,Error)
  66.  
  67. DIM StopGad OF ButtonGadget
  68. StopGad.Size(80,2*GadHeight)
  69. StopGad.Position(-80,GadTopEdge)
  70. StopGad.Label("Stop",INSIDE)
  71. PaintWd.InsObject(StopGad,Error)
  72. GadTopEdge:+2*GadHeight
  73.  
  74. DIM ClearGad OF ButtonGadget
  75. ClearGad.Size(80,GadHeight)
  76. ClearGad.Position(-80,GadTopEdge)
  77. ClearGad.Label("Clear",INSIDE)
  78. ClearGad.EventHandler(ClearEvent())
  79. PaintWd.InsObject(ClearGad,Error)
  80. GadTopEdge:+GadHeight
  81.  
  82. DIM CurveGad OF ButtonGadget
  83. CurveGad.Size(80,GadHeight)
  84. CurveGad.Position(-80,GadTopEdge)
  85. CurveGad.Label("Curve",INSIDE)
  86. CurveGad.Disable
  87. CurveGad.EventHandler(CurveEvent())
  88. PaintWd.InsObject(CurveGad,Error)
  89. GadTopEdge:+GadHeight
  90.  
  91. DIM LineGad OF ButtonGadget
  92. LineGad.Size(80,GadHeight)
  93. LineGad.Position(-80,GadTopEdge)
  94. LineGad.Label("Line",INSIDE)
  95. LineGad.EventHandler(LineEvent())
  96. PaintWd.InsObject(LineGad,Error)
  97. GadTopEdge:+GadHeight
  98.  
  99. DIM CircleGad OF ButtonGadget
  100. CircleGad.Size(80,GadHeight)
  101. CircleGad.Position(-80,GadTopEdge)
  102. CircleGad.Label("Circle",INSIDE)
  103. CircleGad.EventHandler(CircleEvent())
  104. PaintWd.InsObject(CircleGad,Error)
  105. GadTopEdge:+GadHeight
  106.  
  107. DIM FillGad OF ButtonGadget
  108. FillGad.Size(80,GadHeight)
  109. FillGad.Position(-80,GadTopEdge)
  110. FillGad.Label("Fill",INSIDE)
  111. FillGad.EventHandler(FillEvent())
  112. PaintWd.InsObject(FillGad,Error)
  113. GadTopEdge:+GadHeight
  114.  
  115. DIM Palette OF PaletteGadget
  116. Palette.Size(80,PaintWd.Window@.Height-7*GadHeight-14)
  117. Palette.Position(-80,-(PaintWd.Window@.Height-7*GadHeight-15))
  118. Palette.IndicatorHeight(12)
  119. Palette.Color(1)
  120. Palette.Depth(3)
  121. Palette.EventHandler(PaletteEvent())
  122. PaintWd.InsObject(Palette,Error)
  123.  
  124. DIM TextObj OF CITText
  125. TextObj.BackColor(3)
  126. PaintWd.InsObject(TextObj,Error)
  127.  
  128. PaintWd.MouseMove(TRUE)
  129.  
  130. IF Error THEN
  131.   STOP "Some of the objects could not be created."
  132. ELSE
  133.   WHILE NOT (StopGad.Pressed AND Requester.Request("Stop program?","Yes|No")) DO WAIT
  134. ENDIF
  135.  
  136. FreeTmpRas
  137. CITWorkbench.RemObject(PaintScreen)
  138.  
  139. // ********* end of main program ***************
  140.  
  141. PROC ClearEvent(dummy OF USHORT)
  142.   IF Requester.Request("Clear all?","Yes|No") THEN
  143.     SetAPen(RP,0)
  144.     RectFill(RP,4,11,555,PaintWd.Window@.Height-3)
  145.     SetAPen(RP,Palette.Value)
  146.   ENDIF
  147. ENDPROC ClearEvent
  148.  
  149. PROC CurveEvent(dummy OF USHORT)
  150.   CurveGad.Disable
  151.   LineGad.Enable
  152.   CircleGad.Enable
  153.   FillGad.Enable
  154.   MODE:=CURVE
  155. ENDPROC CurveEvent
  156.  
  157. PROC LineEvent(dummy OF USHORT)
  158.   CurveGad.Enable
  159.   LineGad.Disable
  160.   CircleGad.Enable
  161.   FillGad.Enable
  162.   MODE:=LINE
  163. ENDPROC LineEvent
  164.  
  165. PROC CircleEvent(dummy OF USHORT)
  166.   CurveGad.Enable
  167.   LineGad.Enable
  168.   CircleGad.Disable
  169.   FillGad.Enable
  170.   MODE:=CIRCLE
  171. ENDPROC CircleEvent
  172.  
  173. PROC FillEvent(dummy OF USHORT)
  174.   CurveGad.Enable
  175.   LineGad.Enable
  176.   CircleGad.Enable
  177.   FillGad.Disable
  178.   MODE:=FILL
  179. ENDPROC FillEvent
  180.  
  181. PROC PaletteEvent(dummy OF USHORT)
  182.   SetAPen(RP,Palette.Value)
  183. ENDPROC PaletteEvent
  184.  
  185. PROC Button(Down OF BYTE,x OF FLOAT,y OF FLOAT)
  186.   LOCAL dx OF LONG
  187.   LOCAL dy OF LONG
  188.  
  189.   ButtonDown:=Down
  190.   CASE MODE OF
  191.   WHEN LINE
  192.     IF Down THEN
  193.       PaintWd.Coordinates(DownX,DownY)
  194.       PaintWd.Coordinates(MouseX,MouseY)
  195.       SetDrMd(RP,2)  // DrawMode=COMPLEMENT
  196.     ELSE
  197.       Move(RP,DownX,DownY)
  198.       Draw(RP,MouseX,MouseY)
  199.       PaintWd.Coordinates(MouseX,MouseY)
  200.       SetDrMd(RP,0)  // DrawMode=JAM1
  201.       Move(RP,DownX,DownY)
  202.       Draw(RP,MouseX,MouseY)
  203.     ENDIF
  204.   WHEN CIRCLE
  205.     IF Down THEN
  206.       PaintWd.Coordinates(DownX,DownY)
  207.       PaintWd.Coordinates(MouseX,MouseY)
  208.       SetDrMd(RP,2)  // DrawMode=COMPLEMENT
  209.       WritePixel(RP,DownX,DownY)
  210.     ELIF DownX<>x AND DownY<>y THEN
  211.       dx:=(MouseX-DownX)/2; dy:=(MouseY-DownY)/2
  212.       r:=SQR(dx*dx+dy*dy*XYratio*XYratio)
  213.       DrawEllipse(RP,DownX+dx,DownY+dy,r,r/XYratio)
  214.       PaintWd.Coordinates(MouseX,MouseY)
  215.       SetDrMd(RP,0)  // DrawMode=JAM1
  216.       dx:=(MouseX-DownX)/2; dy:=(MouseY-DownY)/2
  217.       r:=SQR(dx*dx+dy*dy*XYratio*XYratio)
  218.       DrawEllipse(RP,DownX+dx,DownY+dy,r,r/XYratio)
  219.     ENDIF
  220.   WHEN FILL
  221.     IF Down THEN
  222.       PaintWd.Coordinates(MouseX,MouseY)
  223.       dummy:=Flood(RP,1,MouseX,MouseY)
  224.     ENDIF
  225.   OTHERWISE
  226.     PaintWd.Coordinates(MouseX,MouseY)  
  227.   ENDCASE
  228. ENDPROC Button
  229.  
  230. PROC MouseMove(x OF FLOAT,y OF FLOAT)
  231.   LOCAL dx OF LONG
  232.   LOCAL dy OF LONG
  233.   LOCAL r OF LONG
  234.  
  235.   TextObj.Print(400,2-11,"x ="+STR$("-###",x))
  236.   TextObj.Print(470,2-11,"y ="+STR$("-###",y))
  237.   IF ButtonDown THEN
  238.     CASE MODE OF
  239.     WHEN CURVE
  240.       Move(RP,MouseX,MouseY)
  241.       PaintWd.Coordinates(MouseX,MouseY)
  242.       Draw(RP,MouseX,MouseY)
  243.     WHEN LINE
  244.       Move(RP,DownX,DownY)
  245.       Draw(RP,MouseX,MouseY)
  246.       PaintWd.Coordinates(MouseX,MouseY)
  247.       Move(RP,DownX,DownY)
  248.       Draw(RP,MouseX,MouseY)
  249.     WHEN CIRCLE
  250.       IF DownX<>x AND DownY<>y THEN
  251.         dx:=(MouseX-DownX)/2; dy:=(MouseY-DownY)/2
  252.         r:=SQR(dx*dx+dy*dy*XYratio*XYratio)
  253.         DrawEllipse(RP,DownX+dx,DownY+dy,r,r/XYratio)
  254.         PaintWd.Coordinates(MouseX,MouseY)
  255.         dx:=(MouseX-DownX)/2; dy:=(MouseY-DownY)/2
  256.         r:=SQR(dx*dx+dy*dy*XYratio*XYratio)
  257.         DrawEllipse(RP,DownX+dx,DownY+dy,r,r/XYratio)
  258.       ENDIF
  259.     OTHERWISE
  260.       // No action
  261.     ENDCASE
  262.   ENDIF
  263. ENDPROC MouseMove
  264.  
  265. MODULE TempRas
  266.   USE System
  267.   USE RastPort
  268.   USE GraphicsLibrary
  269.  
  270.   EXPORT AllocTmpRas,FreeTmpRas
  271.  
  272.   DIM TBuf OF POINTER TO UBYTE   // Plane pointer
  273.   DIM TRas OF TmpRas
  274.   DIM TmpRasW OF SHORT, TmpRasH OF SHORT
  275.  
  276.   FUNC AllocTmpRas(REF RP OF RastPort,w OF SHORT,h OF SHORT) OF SHORT
  277.     TBuf:=AllocRaster(w,h)
  278.     IF TBuf=0 THEN
  279.       RETURN FALSE
  280.     ENDIF
  281.     RP.TmpRas:=InitTmpRas(ADR(TRas),TBuf,RASSIZE(w,h))
  282.     TmpRasW:=w; TmpRasH:=h
  283.     RETURN TRUE
  284.   ENDFUNC AllocTmpRas
  285.  
  286.   PROC FreeTmpRas
  287.     IF TBuf THEN
  288.       FreeRaster(TBuf,TmpRasW,TmpRasH)
  289.       TBuf:=0
  290.     ENDIF
  291.   ENDPROC FreeTmpRas
  292.  
  293.   PROC TmpSignal(s OF LONG) SIGNAL
  294.     CASE s OF
  295.     WHEN SIG_CLOSE,SIG_DISCARD,SIG_CLEAR,SIG_END
  296.       FreeTmpRas
  297.     OTHERWISE
  298.       // No action
  299.     ENDCASE
  300.   ENDPROC TmpSignal
  301.  
  302. ENDMODULE TempRas
  303.